{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit TestPlayer;

interface

uses
  Windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, StdCtrls, Buttons, ActnList, ComCtrls, TestSession, TestCore,
  VisualUtils, MiscUtils, LCLType, Math, QuestionBrowser, TestScore,
  NavigationDiagram, QuestionScreens, TestUiUtils, Windows7Taskbar;

type
  TTestPlayerFrame = class(TFrame, ICloseQueryListener, INavigationDiagramHost{ internal })
    actBack: TAction;
    actAdvance: TAction;
    actAnswer: TAction;
    actFinishWork: TAction;
    actBrowse: TAction;
    alMain: TActionList;
    ApplicationProperties: TApplicationProperties;
    btnAnswer: TButton;
    btnFinishWork: TButton;
    btnBrowse: TButton;
    bvlBottom: TBevel;
    bvlTop: TBevel;
    ilMain: TImageList;
    imgTime: TImage;
    lblPartRightTotal: TLabel;
    lblPartRightTotalTitle: TLabel;
    pnlDiagram: TPanel;
    pnlBaseline1: TPanel;
    pbxTime: TPaintBox;
    pnlMain: TPanel;
    pnlBottom: TPanel;
    pnlTop: TPanel;
    tbrNavigator: TToolBar;
    tbBack: TToolButton;
    tbAdvance: TToolButton;
    tbSpacer: TToolButton;
    tmShowRemainingTime: TTimer;
    procedure actAdvanceExecute(Sender: TObject);
    procedure actAdvanceUpdate(Sender: TObject);
    procedure actAnswerExecute(Sender: TObject);
    procedure actAnswerUpdate(Sender: TObject);
    procedure actBackExecute(Sender: TObject);
    procedure actBackUpdate(Sender: TObject);
    procedure actBrowseExecute(Sender: TObject);
    procedure actBrowseUpdate(Sender: TObject);
    procedure actFinishWorkExecute(Sender: TObject);
    procedure actFinishWorkUpdate(Sender: TObject);
    procedure ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
    procedure FrameEnter(Sender: TObject);
    procedure pbxTimePaint(Sender: TObject);
    procedure tmShowRemainingTimeTimer(Sender: TObject);
  private
    FConnector: TTestSessionConnector;
    FSession: TTestSession;
    FQuestions: TQuestionList;
    FScreen: TFrame;
    FCleanAnswerVersion: Int64;
    FTimedOut: Boolean;
    FStartTick: Cardinal;
    FTimeLimited: Boolean;
    FTimeLimit: TDateTime;
    FDiagram: TNavigationDiagramFrame;
    FWindows7Taskbar: TWindows7Taskbar;
    procedure SelectQuestion(Index: Integer);
    function SelectedQuestionIndex: Integer;
    function GetQuestion: TQuestion;
    function AnswerChanged: Boolean;
    procedure SaveAnswer;
    procedure ReleaseScreen;
    procedure UpdatePartRightTotal;
    procedure DisplayPartRightTotal(Percent: Integer);
    procedure UpdateTime;
    function GetRemainingTime: TDateTime;
    procedure CloseHostForm;
    { private declarations }
  public
    destructor Destroy; override;
    procedure SetUp(var Connector: TTestSessionConnector);
    function CanClose: Boolean;

    { INavigationDiagramHost (internal) }
    function GetItemColor(ItemIndex: Integer): TColor;
    function GetItemHint(ItemIndex: Integer): String;
    procedure ItemSelected(ItemIndex: Integer);

    { public declarations }
  end; 

implementation

{$R *.lfm}
{$R *.rc}

resourcestring
  SFinishWork = 'Do you want to finish the test?';
  SConfirmation = 'Confirmation';
  SFinish = 'Finish';
  SNotNow = 'Not Now';

const
  TIME_MARGIN_X = 10;
  TIME_MARGIN_Y = 2;
  SECOND_RESOLUTION_THRESHOLD = 1 / (24*60*60) * 30;
  ALMOST_MINUTE = 1 / (24*60) * 0.999;

{ TTestPlayerFrame }

procedure TTestPlayerFrame.pbxTimePaint(Sender: TObject);
var
  c: TCanvas;
  ts: TTextStyle;
  TimeLeft: TDateTime;
  s: String;
  p: Double;
  r: TRect;
begin
  c := pbxTime.Canvas;
  c.Brush.Color := $e8e8e8;
  c.Pen.Color := clBlack;
  c.Rectangle(pbxTime.ClientRect);

  if FTimeLimited then
  begin
    TimeLeft := GetRemainingTime;
    try
      p := TimeLeft / FTimeLimit;
    except
      p := 0;
    end;

    r := InflateRectangle(pbxTime.ClientRect, -1, -1);
    r.Right := r.Left + Round((r.Right - r.Left) * p);
    c.Brush.Color := $ffccaa;
    c.FillRect(r);

    if TimeLeft > SECOND_RESOLUTION_THRESHOLD then
      s := FormatDateTime('hh:nn', TimeLeft + ALMOST_MINUTE) { round up to minutes }
    else
      s := FormatDateTime('hh:nn:ss', TimeLeft);

    if TimeLeft > 0 then
      c.Font.Color := clBlack
    else
      c.Font.Color := clRed;

    ts := pbxTime.Canvas.TextStyle;
    ts.Alignment := taCenter;
    ts.Layout := tlCenter;
    c.TextRect(pbxTime.ClientRect, 0, 0, s, ts);
  end;
end;

procedure TTestPlayerFrame.tmShowRemainingTimeTimer(Sender: TObject);
begin
  UpdateTime;
end;

procedure TTestPlayerFrame.actAnswerUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := AnswerChanged;
end;

procedure TTestPlayerFrame.actBackExecute(Sender: TObject);
begin
  SelectQuestion(SelectedQuestionIndex - 1);
end;

procedure TTestPlayerFrame.actBackUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := (SelectedQuestionIndex > 0) and not AnswerChanged;
end;

procedure TTestPlayerFrame.actBrowseExecute(Sender: TObject);
var
  Titles: TStringList;
  i, Index: Integer;
begin
  Titles := TStringList.Create;
  try
    for i := 0 to FSession.ItemCount-1 do
      Titles.AddObject(FQuestions[i].Title, TObject(Ord(FSession.Items[i].Answered)));
    Index := SelectedQuestionIndex;

    if TQuestionBrowserForm.OpenModal(Titles, Index)
      and (Index <> SelectedQuestionIndex) then
      SelectQuestion(Index);
  finally
    Titles.Free;
  end;
end;

procedure TTestPlayerFrame.actBrowseUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := FSession.BrowsableQuestions and not AnswerChanged;
end;

procedure TTestPlayerFrame.actFinishWorkExecute(Sender: TObject);
begin
  CloseHostForm;
end;

procedure TTestPlayerFrame.actFinishWorkUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := not AnswerChanged;
end;

procedure TTestPlayerFrame.ApplicationPropertiesIdle(Sender: TObject;
  var Done: Boolean);
begin
  FDiagram.SelectionEnabled := not AnswerChanged;
end;

function TTestPlayerFrame.CanClose: Boolean;
var
  r: TSessionResult;
  p: TWinControl;
begin
  Application.Restore;
  Result := QuestionDlg(SConfirmation, SFinishWork, mtConfirmation,
    [mrYes, SFinish, mrCancel, SNotNow], 0) = mrYes;
  if Result then
  begin
    SaveAnswer;
    r := FConnector.FinishWork;
    try
      if r <> nil then
      begin
        p := Parent;
        Parent := nil;
        TTestScoreFrame.Embed(r, FQuestions, p);
        Result := FALSE;
        Application.ReleaseComponent(Self);
      end;
    finally
      r.Free;
    end;
  end;
end;

procedure TTestPlayerFrame.FrameEnter(Sender: TObject);
begin
  if FScreen <> nil then
    SelectFirstChild(FScreen);
end;

procedure TTestPlayerFrame.actAnswerExecute(Sender: TObject);
var
  n, AnswerCount: Integer;
  WasAnswered: Boolean;
begin
  WasAnswered := FSession.Items[SelectedQuestionIndex].Answered;
  SaveAnswer;

  if not WasAnswered then
  begin
    AnswerCount := FSession.AnswerCount;
    FWindows7Taskbar.SetProgressValue(AnswerCount, FSession.ItemCount);

    if AnswerCount = FSession.ItemCount then
      CloseHostForm
    else
    begin
      n := SelectedQuestionIndex;
      repeat
        n := (n+1) mod FSession.ItemCount;
      until (n = SelectedQuestionIndex) or not FSession.Items[n].Answered;
      if n <> SelectedQuestionIndex then
        SelectQuestion(n);
    end;
  end;
end;

procedure TTestPlayerFrame.actAdvanceUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := (SelectedQuestionIndex < FSession.ItemCount - 1)
    and not AnswerChanged;
end;

procedure TTestPlayerFrame.actAdvanceExecute(Sender: TObject);
begin
  SelectQuestion(SelectedQuestionIndex + 1);
end;

procedure TTestPlayerFrame.SelectQuestion(Index: Integer);
var
  Question: TQuestion;
  Screen: IQuestionScreen;
begin
  SaveAnswer;
  LockRedraw(pnlMain);
  try
    if Parent <> nil then
      FindParentForm(Self).ActiveControl := pnlMain;
    ReleaseScreen;
    try
      FDiagram.SelectedItemIndex := Index;

      Question := FQuestions[Index];
      FScreen := QuestionScreenRegistry.Find(
        TQuestionClass(Question.ClassType)).Create(nil);
      Screen := FScreen as IQuestionScreen;

      FScreen.Align := alClient;
      FScreen.Parent := pnlMain;
      Screen.SetUp(Question);

      if (not FSession.EditableAnswers and FSession.Items[Index].Answered) or FTimedOut then
        Screen.GoReadOnly;
      FCleanAnswerVersion := Screen.GetQuestion.Response.Version;

      SelectFirstChild(FScreen);
    except
      ReleaseScreen;
    end;
  finally
    UnlockRedraw(pnlMain);
  end;
end;

function TTestPlayerFrame.SelectedQuestionIndex: Integer;
begin
  Result := FDiagram.SelectedItemIndex;
end;

function TTestPlayerFrame.GetQuestion: TQuestion;
begin
  if FScreen = nil then
    Result := nil
  else
    Result := (FScreen as IQuestionScreen).GetQuestion;
end;

function TTestPlayerFrame.AnswerChanged: Boolean;
begin
  Result := (GetQuestion <> nil) and (GetQuestion.Response.Version <> FCleanAnswerVersion);
end;

procedure TTestPlayerFrame.SaveAnswer;
var
  PartRight, PartRightTotal: Single;
begin
  if AnswerChanged then
  begin
    if not FSession.EditableAnswers then
      (FScreen as IQuestionScreen).GoReadOnly;
    FQuestions[SelectedQuestionIndex].Response.Assign(GetQuestion.Response);
    FSession.Items[SelectedQuestionIndex].Answered := TRUE;
    FCleanAnswerVersion := GetQuestion.Response.Version;

    FConnector.SetResponse(SelectedQuestionIndex, GetQuestion.Response,
      PartRight, PartRightTotal);

    FSession.Items[SelectedQuestionIndex].PartRight := PartRight;
    FSession.PartRight := PartRightTotal;
    UpdatePartRightTotal;
    FDiagram.ColorsChanged;
  end;
end;

procedure TTestPlayerFrame.ReleaseScreen;
begin
  if FScreen <> nil then
  begin
    FScreen.Parent := nil;
    Application.ReleaseComponent(FScreen);
    FScreen := nil;
  end;
end;

procedure TTestPlayerFrame.UpdatePartRightTotal;
var
  Display: Boolean;
begin
  Display := FSession.PartRight <> -1;
  lblPartRightTotalTitle.Visible := Display;
  lblPartRightTotal.Visible := Display;
  if Display then
    DisplayPartRightTotal(Round(FSession.PartRight * 100));
end;

procedure TTestPlayerFrame.DisplayPartRightTotal(Percent: Integer);
begin
  lblPartRightTotal.Caption := Format(' %d%%', [Percent]);
end;

procedure TTestPlayerFrame.UpdateTime;
begin
  if FTimeLimited then
  begin
    if not FTimedOut and (GetRemainingTime = 0) then
    begin
      FTimedOut := TRUE;
      if FScreen <> nil then
        (FScreen as IQuestionScreen).GoReadOnly;
      SaveAnswer;
    end;

    pbxTime.Invalidate;
  end;
end;

function TTestPlayerFrame.GetRemainingTime: TDateTime;
begin
  if FTimeLimited then
    Result := Max(FTimeLimit - GetIntervalSince(FStartTick) / (24*60*60*1000), 0)
  else
    Result := 0;
end;

procedure TTestPlayerFrame.CloseHostForm;
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Self);
  if Form <> nil then
    Form.Close;
end;

function TTestPlayerFrame.GetItemColor(ItemIndex: Integer): TColor;
var
  Item: TTestSessionItem;
begin
  Item := FSession.Items[ItemIndex];
  if Item.Answered then
  begin
    if Item.PartRight = -1 then
      Result := TDiagramColorScheme.AnsweredColor
    else
      Result := TDiagramColorScheme.GetColorForPartRight(Item.PartRight);
  end
  else
    Result := TDiagramColorScheme.UnansweredColor;
end;

function TTestPlayerFrame.GetItemHint(ItemIndex: Integer): String;
begin
  if FSession.BrowsableQuestions and not AnswerChanged then
    Result := FQuestions[ItemIndex].Title
  else
    Result := '';
end;

procedure TTestPlayerFrame.ItemSelected(ItemIndex: Integer);
begin
  if not AnswerChanged then
    SelectQuestion(ItemIndex);
end;

destructor TTestPlayerFrame.Destroy;
begin
  ReleaseScreen;
  FreeAndNil(FDiagram);
  FreeAndNil(FQuestions);
  FreeAndNil(FSession);
  FreeAndNil(FConnector);
  FreeAndNil(FWindows7Taskbar);
  inherited;
end;

procedure TTestPlayerFrame.SetUp(var Connector: TTestSessionConnector);
var
  Size: TSize;
  Weights: TIntegerArray;
  i: Integer;
begin
  Assert( FConnector = nil );
  FConnector := Connector;
  Connector := nil;

  HandleNeeded;

  LoadActionImages(alMain);
  StretchToWidest([tbBack, tbAdvance]);
  btnAnswer.Constraints.MinWidth := Round(tbBack.Constraints.MinWidth * 1.5);
  FWindows7Taskbar := TWindows7Taskbar.Create;

  FSession := FConnector.GetSession;
  if FSession.ItemCount = 0 then
    raise Exception.Create('No questions.');

  FQuestions := TQuestionList.Create;
  FConnector.GetQuestions(FQuestions);
  if FQuestions.Count <> FSession.ItemCount then
    raise Exception.CreateFmt('Question count mismatch (%d <> %d).',
      [FQuestions.Count, FSession.ItemCount]);

  SetLength(Weights, FQuestions.Count);
  for i := 0 to High(Weights) do
    Weights[i] := FQuestions[i].Weight;
  FDiagram := TNavigationDiagramFrame.Embed(Weights, Self, pnlDiagram);

  actBrowse.Visible := FSession.BrowsableQuestions;

  DisplayPartRightTotal(100);
  lblPartRightTotal.Constraints.MinWidth := GetPreferredControlSize(lblPartRightTotal).cx;
  UpdatePartRightTotal;

  FStartTick := GetTickCount;
  FTimeLimited := FSession.TimeTotal <> -1;
  imgTime.Visible := FTimeLimited;
  pbxTime.Visible := FTimeLimited;
  tmShowRemainingTime.Enabled := FTimeLimited;
  if FTimeLimited then
  begin
    FTimeLimit := FSession.TimeTotal;
    Size := pbxTime.Canvas.TextExtent('00:00:00');
    SetFixedSizeConstraints(pbxTime, Size.cx + TIME_MARGIN_X*2, Size.cy + TIME_MARGIN_Y*2);
    LoadPngResourceToPicture('TestPlayer/time.png', imgTime.Picture);
    imgTime.Hint := pbxTime.Hint;
    UpdateTime;
  end;

  SelectQuestion(0);
end;

end.

